Public Transportation Accessibility in Twin Cities

Mapping sthe Education Sources in Twin Cities

schools_stops %>% 
  ggplot(aes(x = number_school, y = number_of_stops))+
  stat_summary_bin(fun = "mean", bins = 5, geom = "point")+ #divides the number of schools by the number of bins, so Bin 1: 0-10 schools, Bin 2: 10:20, etc. 
  geom_smooth(method = "lm")+
  labs(x = "Mean Number of Schools (Pre and Post-Secondary) in Tract", 
       y = "Mean Number of Bus Stops in Tract")+ # avg # of stops in areas with similar # of schools
  theme_classic()

schools_stops %>% 
  ggplot(aes(x = number_school, y = number_of_stops))+
  geom_point(alpha = 0.5)+
  geom_smooth(method = "lm")+
  labs(x = "Number of Schools (Pre and Post-Secondary) in Tract", y = "Number of Bus Stops in Tract")+ 
  theme_classic()

function

map

# need help:  don't know how to add title with var?

census_var_plot <- function(var, title){
  # using chosen variable to make the map with bus stops
  ggplot()+
  geom_sf(data = census2023, aes(fill = {{var}}))+
  geom_sf(data = stops_sf_county, color = "green", size = 0.1)+
  scale_fill_gradient(low = "orange", high = "blue")+
    labs(fill="", title = str_to_title(title))
}

census_var_perc_plot <- function(var, title){
  # using the percentage of each race  to make the map with bus stops
  ggplot()+
  geom_sf(data = census2023, aes(fill = {{var}}/population))+
  geom_sf(data = stops_sf_county, color = "green", size = 0.1)+
  scale_fill_gradient(low = "orange", high = "blue")+
   labs(fill="", title = str_c("Percentage of ",title))
}

for(i in 1:2){
  print(census_var_plot(get(name[i]), name[i]))
}

for(i in 3:9){
  print(census_var_perc_plot(get(name[i]), name[i]))
}

scatter plot

# don't know how to modify label y axis

census_point_plot <- function(var, title){
 # Function for plotting the linear relationship between chosen variables and the number of bus stops
  stops_census_join_summ %>% 
  ggplot(aes(x = {{var}}, y = number_of_stops))+
    geom_point()+
    geom_smooth(method = "lm")+
    labs(y = "Number of Bus Stops in Tract",title = str_to_title(title))+
    theme_classic()
}

census_point_density_plot <- function(var, title){
   # Function for plotting the linear relationship between
  # percentage of each ethnicity group and the number of bus stops
  stops_census_join_summ %>% 
  ggplot(aes(x = {{var}}/population, y = number_of_stops))+
    geom_point()+
    geom_smooth(method = "lm")+
    labs(y = "Number of Bus Stops in Tract", title = str_c("Percentage of ",title))+
    theme_classic()
}



for(i in 1:2){
  print(census_point_plot(get(name[i]), name[i]))
}

for(i in 3:7){
  print(census_point_density_plot(get(name[i]), name[i]))
}

Overview and Covid comparison

# total ridership over 5 years
used_ridership_all %>% 
  group_by(nYear) %>%
  mutate(Total_Riders = sum(Total_Riders,na.rm = TRUE)) %>% 
  ggplot(aes(x=nYear, y=Total_Riders))+
  geom_point()+
  geom_line()+
  labs(x = "Year", y = "Total Riders")

# 2 comparisons included: weekday vs weekend, and among each year
weekends_weekdays %>% 
  ggplot(aes(x= nYear, y = Total_Riders)) +
  geom_point()+
  geom_line()+
  facet_wrap(~Schedule)+
  labs(x = "Year", y = "Total Riders")

used_ridership_all %>% filter(!(rte_class %in% c("CommRai","SuburbL","Support"))) %>% 
  group_by(nYear, rte_class) %>%
  mutate(Total_Riders = sum(Total_Riders,na.rm = TRUE)) %>% 
  ggplot(aes(x=nYear, y = Total_Riders)) +
  geom_point()+
  geom_line()+
  facet_wrap(~rte_class)+
  labs(x = "Year", y = "Total Riders")

# total ridership for BRT increase because increasing lines
used_ridership_all%>% 
  filter(rte_class == "BRT") %>% 
  distinct(nYear,Route) %>% 
  group_by(nYear) %>% 
  summarise(num_BRT = n()) %>% 
  ggplot(aes(x =nYear, y = num_BRT))+
  geom_point()+
  geom_line() # the increase of BRT can replace one of the orginal line

# daily load drops
used_ridership_all %>% 
  group_by(nYear) %>%
  mutate(Daily_load = n()) %>% 
  ggplot(aes(x=nYear, y= Daily_load))+
  geom_line()+
  geom_point()

# supply # of roads drops
used_ridership_all %>% 
  distinct(nYear,Route) %>% 
  group_by(nYear) %>% 
  mutate(nRoute = n()) %>% 
  ggplot(aes(x=nYear, y= nRoute))+
  geom_line()+
  geom_point()

sessionInfo()
## R version 4.3.2 (2023-10-31)
## Platform: x86_64-apple-darwin20 (64-bit)
## Running under: macOS Monterey 12.6.2
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/Chicago
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] Hmisc_5.1-1     sf_1.0-15       tidycensus_1.6  lubridate_1.9.2
##  [5] forcats_1.0.0   stringr_1.5.0   purrr_1.0.2     readr_2.1.4    
##  [9] tidyr_1.3.0     tibble_3.2.1    ggplot2_3.4.4   tidyverse_2.0.0
## [13] dplyr_1.1.3    
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.4       xfun_0.40          htmlwidgets_1.6.2  tigris_2.0.4      
##  [5] lattice_0.21-9     tzdb_0.4.0         vctrs_0.6.5        tools_4.3.2       
##  [9] generics_0.1.3     curl_5.2.0         proxy_0.4-27       fansi_1.0.6       
## [13] cluster_2.1.4      pkgconfig_2.0.3    Matrix_1.6-1.1     KernSmooth_2.23-22
## [17] data.table_1.15.2  checkmate_2.3.1    uuid_1.1-1         lifecycle_1.0.4   
## [21] farver_2.1.1       compiler_4.3.2     munsell_0.5.0      htmltools_0.5.6   
## [25] class_7.3-22       yaml_2.3.7         htmlTable_2.4.2    Formula_1.2-5     
## [29] pillar_1.9.0       crayon_1.5.2       classInt_0.4-10    wk_0.9.0          
## [33] rpart_4.1.21       nlme_3.1-163       tidyselect_1.2.0   rvest_1.0.3       
## [37] digest_0.6.33      stringi_1.7.12     labeling_0.4.3     splines_4.3.2     
## [41] fastmap_1.1.1      grid_4.3.2         colorspace_2.1-0   cli_3.6.2         
## [45] magrittr_2.0.3     base64enc_0.1-3    utf8_1.2.4         e1071_1.7-14      
## [49] foreign_0.8-85     withr_3.0.0        backports_1.4.1    scales_1.3.0      
## [53] rappdirs_0.3.3     timechange_0.2.0   rmarkdown_2.24     httr_1.4.7        
## [57] nnet_7.3-19        gridExtra_2.3      hms_1.1.3          evaluate_0.21     
## [61] knitr_1.43         mgcv_1.9-0         s2_1.1.4           rlang_1.1.3       
## [65] Rcpp_1.0.11.6      glue_1.7.0         DBI_1.1.3          xml2_1.3.5        
## [69] rstudioapi_0.15.0  jsonlite_1.8.7     R6_2.5.1           units_0.8-4